home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / HFTUBE.ZIP / TUBERAD.PAS < prev    next >
Pascal/Delphi Source File  |  1995-12-12  |  850b  |  32 lines

  1. Program Test;
  2. Uses Crt;
  3. Var N,M:Word;
  4.     R,Xp,Yp,Rad,A,Kx,Ky:Real;
  5.     Fil:File;
  6.     RadLine:Array[0..511] Of Byte;
  7. Begin
  8.  Asm Mov Ax,0013h; Int 10h; End;
  9.  Assign(Fil,'TUBE.RAD'); ReWrite(Fil,1);
  10.  Mem[$A000:160+100*320]:=1;
  11.  R:=128;
  12.  For M:=0 to 63 Do Begin
  13. {  R:=128+20*Sin(2*M*Pi/32);}
  14.   Xp:={Sin(M*Pi/32)*30}0;
  15.   Yp:=Cos(M*Pi/32)*80;
  16.   Mem[$A000:Round(160-Xp)+Round(100-Yp)*320]:=15;
  17.   For N:=0 to 511 Do Begin
  18.  
  19. {   R:=130+40*Sin(5*N*Pi/256)*Sin(5*M*Pi/32);}
  20.  
  21.    A:=N*Pi/256; Kx:=Sin(A); Ky:=Cos(A);
  22.    Rad:=(-Xp*Kx-Yp*Ky+Sqrt(2*Xp*Kx*Yp*Ky-(Yp*Yp*Kx*Kx+Xp*Xp*Ky*Ky-R*R*Kx*Kx-R*R*Ky*Ky))) / (Kx*Kx+Ky*Ky);
  23.    Mem[$A000:Round(160+Kx*Rad)+Round(100+Ky*Rad)*320]:=15;
  24.    RadLine[N]:=Round(Rad);
  25.   End;
  26.   BlockWrite(Fil,RadLine,512);
  27.  End;
  28.  Close(Fil);
  29. { Repeat Until KeyPressed;}
  30.  Asm Mov Ax,0003h; Int 10h; End;
  31. End.
  32.